unit uPingIcmp;

interface

uses
  winsock,Windows;

function PingICMP (Host:string):Boolean;

implementation

type
    ip_option_information = packed record  // ?????????? ????????? IP (??????????
				    // ???? ????????? ? ?????? ????? ?????? ? RFC791.
        Ttl : byte;			// ????? ????? (???????????? traceroute-??)
        Tos : byte;			// ??? ????????????, ?????? 0
        Flags : byte;		// ????? ????????? IP, ?????? 0
        OptionsSize : byte;		// ?????? ?????? ? ?????????, ?????? 0, ???????? 40
        OptionsData : Pointer;	// ????????? ?? ?????? 
    end;

   icmp_echo_reply = packed record
        Address : u_long; 	    	 // ????? ???????????
        Status : u_long;	    	 // IP_STATUS (??. ????)
        RTTime : u_long;	    	 // ????? ????? ???-???????? ? ???-??????? 
				         // ? ?????????????
        DataSize : u_short; 	    	 // ?????? ???????????? ??????
        Reserved : u_short; 	    	 // ???????????????
        Data : Pointer; 		 // ????????? ?? ???????????? ??????
        Options : ip_option_information; // ?????????? ?? ????????? IP
    end;

    PIPINFO = ^ip_option_information;
    PVOID = Pointer;

        function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
        function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle';
        function IcmpSendEcho(
                          IcmpHandle : THandle;    // handle, ???????????? IcmpCreateFile()
                          DestAddress : u_long;    // ????? ?????????? (? ??????? ???????)
                          RequestData : PVOID;     // ????????? ?? ?????????? ??????
                          RequestSize : Word;      // ?????? ?????????? ??????
                          RequestOptns : PIPINFO;  // ????????? ?? ?????????? ?????????
                       		                   // ip_option_information (????? ???? nil)
                          ReplyBuffer : PVOID;     // ????????? ?? ?????, ?????????? ??????.
                          ReplySize : DWORD;       // ?????? ?????? ???????
                          Timeout : DWORD          // ????? ???????? ?????? ? ?????????????
                         ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';


function PingICMP (Host:string):Boolean;
var
    hIP : THandle;
    pingBuffer : array [0..31] of Char;
    pIpe : ^icmp_echo_reply;
    pHostEn : PHostEnt;
    wVersionRequested : WORD;
    lwsaData : WSAData;
    error : DWORD;
    destAddress : In_Addr;
    destAddressInt : Longint;
begin
    hIP := IcmpCreateFile();
    GetMem( pIpe,
            sizeof(icmp_echo_reply) + sizeof(pingBuffer));
    pIpe.Data := @pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);
    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
      IcmpCloseHandle(hIP);
      WSACleanup();
      FreeMem(pIpe);
      Exit;
    end;
{    pHostEn :=gethostbyname(pchar(Host));
    error := GetLastError();
    if (error <> 0) then
    begin
      IcmpCloseHandle(hIP);
      WSACleanup();
      FreeMem(pIpe);
      Exit;
    end;
    destAddress := PInAddr(pHostEn^.h_addr_list^)^;
    IcmpSendEcho(hIP,
                 destAddress.S_addr,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 10);}
    destAddressInt := inet_addr(Pchar(Host));
    IcmpSendEcho(hIP,
                 destAddressInt,
                 @pingBuffer,
                 sizeof(pingBuffer),
                 Nil,
                 pIpe,
                 sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                 10);
    error := GetLastError();
    if (error <> 0) then
    begin
      Exit;
    end;
    if pIpe^.Address = destAddressInt then
      Result := true;
    IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
end;

end.
